home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.06 Jun 89 / Lisp sources / structures / towersOfHanoi < prev   
Encoding:
Text File  |  1988-06-01  |  1.8 KB  |  52 lines  |  [TEXT/CCL ]
  1. ; © Copyright 1988 Jean-Pascal J. LANGE.
  2.  
  3. ; towerOfHanoi, first pole is 0
  4.  
  5. (defStruct HanoiTower (stacks nil))
  6.  
  7. (deFun Hanoi (tower)
  8. ; tower of Hanoï program. Asks user for height of stack of disks.
  9. ; stacks is an array of stacks. Each stack is a list.
  10. ; The "objects" we put on the stacks are characters.
  11. ; A is the smallest disk, B is larger, etc...
  12.   (let ((height nil))
  13.     (do ()
  14.         ((integerP height))
  15.       (format t "~&Please type the number of disks in the tower: ")
  16.       (setq height (read)) )
  17.     (format t "~&tower of Hanoï for ~D disk~:P." height)
  18.     (setf (HanoiTower-stacks tower)
  19.           (make-array 3 :initial-element nil) )
  20.     
  21.     (do ((each height (1- each)))
  22.         ((zerop each))
  23.       (addFirst (HanoiTower-stacks tower) 0
  24.                 (code-char (+ (char-code #\A) (1- each))) ) )
  25.     (moveTower tower height 1 3 2) ) )
  26.  
  27. (deFun moveTower (tower nDisks fromPin toPin usingPin)
  28.   (cond ((> nDisks 0)
  29.          (moveTower tower (1- nDisks) fromPin usingPin toPin)
  30.          (moveDisk tower fromPin toPin)
  31.          (moveTower tower (1- nDisks) usingPin toPin fromPin) ) ) )
  32.  
  33. (deFun moveDisk (tower fromPin toPin)
  34. ; moves disk from a pin to another pin. Print the results in the
  35. ; listener window.
  36.   (let ((disk (getAndRemoveFirst (HanoiTower-stacks tower)
  37.                                  (1- fromPin) )))
  38.     (addFirst (HanoiTower-stacks tower) (1- toPin) disk)
  39.     (format t "~&~D -> ~D ~A" fromPin toPin disk) ) )
  40.  
  41. (deFun addFirst (array index item)
  42. ; addFirst is the procedure for push.
  43.   (setf (aref array index)
  44.         (cons item (aref array index)) ) )
  45.  
  46. (deFun getAndRemoveFirst (array index)
  47. ; getAndRemoveFirst is the procedure for pop.
  48.   (let ((first (car (aref array index))))
  49.     (setf (aref array index)
  50.           (cdr (aref array index))  )
  51.     first ) )
  52.